home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / upd-copyr.el < prev    next >
Lisp/Scheme  |  1993-01-08  |  5KB  |  154 lines
  1. ;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file
  2.  
  3. ;;; Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
  6. ;; Keywords: maint
  7.  
  8. ;;; This file is part of GNU Emacs.
  9.  
  10. ;;; This program is free software; you can redistribute it and/or modify
  11. ;;; it under the terms of the GNU General Public License as published by
  12. ;;; the Free Software Foundation; either version 2, or (at your option)
  13. ;;; any later version.
  14. ;;;
  15. ;;; This program is distributed in the hope that it will be useful,
  16. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;; GNU General Public License for more details.
  19. ;;;
  20. ;;; A copy of the GNU General Public License can be obtained from this
  21. ;;; program's author (send electronic mail to roland@ai.mit.edu) or from
  22. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  23. ;;; 02139, USA.
  24.  
  25. ;;; Code:
  26.  
  27. (defconst current-year (substring (current-time-string) -4)
  28.   "String representing the current year.")
  29.  
  30. (defvar current-gpl-version "2"
  31.   "String representing the current version of the GPL.")
  32.  
  33. ;;;###autoload
  34. (defvar replace-copying-with nil
  35.   "*If non-nil, replace copying notices with this file.")
  36.  
  37. (defvar inhibit-update-copyright nil
  38.   "If nil, ask the user whether or not to update the copyright notice.
  39. If the user has said no, we set this to t locally.")
  40.  
  41. ;;;###autoload
  42. (defun update-copyright (&optional replace ask-upd ask-year)
  43.   "Update the copyright notice at the beginning of the buffer
  44. to indicate the current year.  If optional arg REPLACE is given
  45. \(interactively, with prefix arg\) replace the years in the notice
  46. rather than adding the current year after them.
  47. If `replace-copying-with' is set, the copying permissions following the
  48. copyright are replaced as well.
  49.  
  50. If optional third argument ASK is non-nil, the user is prompted for whether
  51. or not to update the copyright.  If optional fourth argument ASK-YEAR is
  52. non-nil, the user is prompted for whether or not to replace the year rather
  53. than adding to it."
  54.   (interactive "*P")
  55.   (save-excursion
  56.     (save-restriction
  57.       (widen)
  58.       (goto-char (point-min))
  59.       ;; Handle abbreviated year lists like "1800, 01, 02, 03".
  60.       (if (re-search-forward (concat (substring current-year 0 2)
  61.                      "\\([0-9][0-9]\\(,\\s \\)+\\)*"
  62.                      (substring current-year 2))
  63.                  nil t)
  64.       (or ask-upd
  65.           (message "Copyright notice already includes %s." current-year))
  66.     (goto-char (point-min))
  67.     (if (and (not inhibit-update-copyright)
  68.          (or (not ask-upd)
  69.              ;; If implicit, narrow it down to things that
  70.              ;; look like GPL notices.
  71.              (prog1
  72.              (search-forward "is free software" nil t)
  73.                (goto-char (point-min))))
  74.          (re-search-forward
  75.           "[Cc]opyright[^0-9]*\\(\\([-, \t]*\\([0-9]+\\)\\)\\)+"
  76.           nil t)
  77.          (or (not ask-upd)
  78.              (save-window-excursion
  79.                (pop-to-buffer (current-buffer))
  80.                (save-excursion
  81.              ;; Show the user the copyright.
  82.              (goto-char (point-min))
  83.              (sit-for 0)
  84.              (or (y-or-n-p "Update copyright? ")
  85.                  (progn
  86.                    (set (make-local-variable
  87.                      'inhibit-update-copyright) t)
  88.                    nil))))))
  89.         (progn
  90.           (setq replace
  91.             (or replace
  92.             (and ask-year
  93.                  (save-window-excursion
  94.                    (pop-to-buffer (current-buffer))
  95.                    (save-excursion
  96.                  ;; Show the user the copyright.
  97.                  (goto-char (point-min))
  98.                  (sit-for 0)
  99.                  (y-or-n-p "Replace copyright year? "))))))
  100.           (if replace
  101.           (delete-region (match-beginning 1) (match-end 1))
  102.         (insert ", "))
  103.           (insert current-year)
  104.           (message "Copyright updated to %s%s."
  105.                (if replace "" "include ") current-year)
  106.       (if replace-copying-with
  107.           (let ((case-fold-search t)
  108.             beg)
  109.         (goto-char (point-min))
  110.         ;; Find the beginning of the copyright.
  111.         (if (search-forward "copyright" nil t)
  112.             (progn
  113.               ;; Look for a blank line or a line
  114.               ;; containing only comment chars.
  115.               (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t)
  116.               (forward-line 1)
  117.             (with-output-to-temp-buffer "*Help*"
  118.               (princ (substitute-command-keys "\
  119. I don't know where the copying notice begins.
  120. Put point there and hit \\[exit-recursive-edit]."))
  121.               (recursive-edit)))
  122.               (setq beg (point))
  123.               (or (search-forward "02139, USA." nil t)
  124.               (with-output-to-temp-buffer "*Help*"
  125.                 (princ (substitute-command-keys "\
  126. I don't know where the copying notice ends.
  127. Put point there and hit \\[exit-recursive-edit]."))
  128.                 (recursive-edit)))
  129.               (delete-region beg (point))))
  130.         (insert-file replace-copying-with))
  131.         (if (re-search-forward
  132.          "; either version \\(.+\\), or (at your option)"
  133.          nil t)
  134.         (progn
  135.           (goto-char (match-beginning 1))
  136.           (delete-region (point) (match-end 1))
  137.           (insert current-gpl-version))))
  138.       (or ask-upd
  139.           (error "This buffer contains no copyright notice!"))))))))
  140.  
  141. ;;;###autoload
  142. (defun ask-to-update-copyright ()
  143.   "If the current buffer contains a copyright notice that is out of date,
  144. ask the user if it should be updated with `update-copyright' (which see).
  145. Put this on write-file-hooks."
  146.   (update-copyright nil t t)
  147.   ;; Be sure return nil; if a write-file-hook return non-nil,
  148.   ;; the file is presumed to be already written.
  149.   nil)
  150.  
  151. (provide 'upd-copyr)
  152.  
  153. ;;; upd-copyr.el ends here
  154.